home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus 1995 #5 & #6
/
Amiga Plus CD - 1995 - No. 5 and 6.iso
/
pd
/
netz
/
ums
/
ums-beta
/
rexx
/
listmanager.rexx
< prev
next >
Wrap
OS/2 REXX Batch file
|
1995-05-30
|
42KB
|
1,247 lines
/* ------------------------------------------------------------------------
:Program. ListManager
:Contents. transfers mail from a mailing list to a group and vice versa
:Author. Kai Bolay [kai]
:Address. Snail Mail: EMail:
:Address. Hoffmannstraße 168 UseNet: kai@studbox.uni-stuttgart.de
:Address. D-71229 Leonberg FIDO: 2:2407/106.3
:Author. hartmut Goebel [hG]
:Address. Aufsesßplatz 5 UseNet: hartmut@oberon.nbg.sub.org
:Address. D-90459 Nürnberg
:Author. Martin Horneffer [mh]
:Address. Warmweiherstr.18 UseNet: mh@umshq.dfv.rwth-aachen.de
:Address. D-52066 Aachen Maus: mh@AC2
:Copyright. Public Domain
:Language. ARexx
:Translator. RexxMast
$Id: ListManager.rexx,v 1.20 1995/05/30 18:59:00 hartmut Exp hartmut $
$Log: ListManager.rexx,v $
# Revision 1.20 1995/05/30 18:59:00 hartmut
# fixed missing f_CDEF
# debuglevel defaults to 5 again, as described in docs
#
# Revision 1.19 1995/05/22 15:08:29 hartmut
# fixed Errors-To:-Header
# fixed dupes check for listmails and thus processing loop
#
# Revision 1.18 1995/05/18 22:42:25 hartmut
# fixed buf with missing ReplyTo in spooled mails
# removed a tippo
#
# Revision 1.17 1995/05/17 17:14:00 hartmut
# Lists.Owner ist now used (see docs)
# "Errors-To:"-Header is set for all served mails
# all UMSMakeFlags() in loops removed wherever this makes sence
#
# Revision 1.16 1995/05/17 20:29:08 hartmut
# removed superfuous DROP statements
# checked all symbol() calls (arg must be string)
# forgotten to strip comma from user names in lists
# user names are stripped in CheckAcces(), too
# changed do w/ leave into do until/while where possible
# reworked SAY msgs in WriteUserMail()
# cosmetics, esp. Tailer (which was unreadable for humans)
# speedup: some UMSMakeFlags() in loops removed
#
# Revision 1.15 1995/05/09 21:44:28 kai
# fixed unbalanced parentheses Line 1075
# fixed dupecheck for received mail in server mode
#
# Revision 1.14 1995/05/03 18:20:02 kai
# hG cosmetics
# fixed hG bugs
#
# Revision 1.13 1995/05/01 21:04:49 kai
# NODEAMONACCOUNT also for server
# fixed hG's bug which forgot last user of a mailinglist
#
# Revision 1.12 1995/05/01 19:00:46 kai
# removed server command FAQ [hG]
# command WHICH implemented (simple version) [hG]
# majordomo aliases for other commands [hG]
# List.users must only contain 1 comma [hG]
# chars $00..$1F, $80..$9F and "," in usernames are converted to spaces [hG]
# only changed parts of config are written now [hG]
# reads configvars ProgramName.ListName.(Status|Password|Owners|Files) [hG]
# new routines: AddTo/RemFromAddrList(), Write(Changed)Var() [hG]
# new routines: Str2AddrList(), AddrList2Str() [hG]
# ShowConfig(): sorted by Clients/Servers [hG]
# news are selected correctly again [hG]
#
# Revision 1.11 1995/04/30 15:45:30 kai
# changed log levels
# misc cosmetic changes
#
# Revision 1.10 1995/04/28 18:43:51 kai
# cosmetic and documentation changes
# added UMSExportedMsg() and UMSCannotExport()
#
# Revision 1.9 1995/04/28 18:09:06 kai
# lots of clean up, structuring, etc. [hG]
# cosmetic changes and speed-up changes [hG]
# marked places todo 'todo' [hG]
# marked open questions '???' [hG]
# new routines FindUser(), FindList() [hG]
# new routines ProcessCrtlMsg(), ProcessCommand() [hG]
# new routines SendNotification(), SendAdminMail(), SendListMail() [hG]
# new routines DupeCheck() (only used in server part) [hG]
# only those config-vars are written which can be changed via ListManager [hG]
# moved code doublications into subroutines [hG]
# removed .COUNT compout variable, called .0 now [hG]
# (this has some advantages) [hG]
# checked nearly all EXPOSEd variables in Server-Part [hG]
# cosmetics
# changed documentation
# removed time() date()
# fixed parked flag bug with missing comma
#
# Revision 1.8 1995/04/24 22:13:36 kai
# cosmetic changes
# converted some "say" to log()
#
# Revision 1.7 1995/04/23 22:02:38 kai
# changed BIT/K/N to NODEAMONACCOUNT (handles flags.user)
# fixed bug with INDEX which also showed client lists
# added "PARKED" support
# changed flags used for dupe check
# don't write .server and .hostname any more
# fixed other bugs with WriteConfig()
# several small changes I don't remember
#
# Revision 1.6 1995/04/14 17:31:42 kai
# changed say to log()
#
# Revision 1.5 1995/04/12 19:57:12 kai
# fixed Bug when forwarding article to list (as client)
#
# Revision 1.4 1995/04/12 19:52:43 kai
# hG's changes and addition "iterate" in ProcessLists()
#
# Revision 1.3 1995/04/10 14:45:31 hG
# 'exported' notes are logged with level 5+(numMsg=0)
# changed list name parsing
# cosmetics/qualities
# Revision 1.2 1995/04/07 15:20:48 kai
# removed <oid> in server code
# added dupe check in server code
#
# Revision 1.1 1995/04/07 14:46:59 kai
# Initial revision
#
------------------------------------------------------------------------ */
/*
Config structure:
global config:
*Lists.Owner human owner of the ListServer (account name)
*Lists.Server ListServer Deamon (account name)
*Lists.Hostname name of this host, used for msg tailers / replyaddr
*Lists.Address email address (only if there's no deamon account)
*Lists.Helpfile
Lists.Mailinglists name "," addr ---> besser group "," name "," addr ???
* means: same name in config-file. Just prefix changed to ProgramName
per-list configuration
*Lists.XXX.descfile
*Lists.XXX.group
*Lists.XXX.alias
*Lists.XXX.access
-Lists.XXX.Users
-Lists.XXX.Owners (read but not yet used)
*Lists.XXX.Password (read but not yet used)
*Lists.XXX.Status (read but not yet used)
Lists.Status m: list of mailinglists changed
Lists.XXX.Status Format: status (upper) "#" changed config vars (lower)
status: C: closed, subscribe must be approved
P: private, only subscribers can write
M: moderated
D: digest
changed: u: list of users
o: list of owners
p: password
s: status (first part only)
Lists.0 nof mailinglists
Lists.XXX.name
Lists.XXX.addr
Users and Owners go into Lists (NAME is the list's name (MAIL for Users))
Lists.XXX.NAME.0 nof entries
Lists.XXX.NAME.YYY.name entry name
Lists.XXX.NAME.YYY.addr entry addr
*: same name in config-file, but 'Lists.XXX' changed to 'ProgamName.ListName'
-: Only in config-file. parsed into stems 'Lists.XXX.foo.YYY' when reading
*/
options results
options failat 20
/*** Startup ***/
signal on BREAK_C
signal on BREAK_D
signal on BREAK_E
signal on BREAK_F
signal on ERROR
signal on HALT
signal on IOERR
signal on SYNTAX
call addlib('ums.library', 0, -210, 11)
call addlib('rexxdossupport.library', 0, -30, 1)
call UMSInitConsts()
parse arg arguments
ProgramName = "ListManager";
ArgsTemplate = "NAME,PASSWORD,SERVER/K,NODEAMONACCOUNT/S,LOOP/K,DEBUGLEVEL/N/K"
args.name = "lists"
args.password = ""
args.server = ""
args.nodeamonaccount = 0
args.loop = ""
args.debuglevel = 5
if strip(arguments) = '?' then do
call writech(STDOUT, ArgsTemplate': ')
arguments = readln(STDIN)
end; else nop
if ~ReadArgs(arguments,ArgsTemplate,"args.") then do
say Fault(RC,ProgramName)
exit 10
end; else nop
drop arguments
/*** Login ***/
account = UMSLogin(args.name, args.password, args.server)
if account = 0 then do
say "unable to login."
exit 20
end
/*** Main ***/
GroupPrefix = "mailinglist."
if args.nodeamonaccount then do
args.bit = FindFlag()
end; else do
args.bit = UMSUSTAT_Old
end
call log(7,"startup")
err = ReadConfig();
if err ~=" " then do /* ??? */
call log(2,"cannot read configuration variable '"ProgramName"."err"'.")
skip HALT
end; else do
if lists.0 = 0 then do
call log(4,"nothing to do, no mailinglists defined")
skip HALT
end
do forever
if lists.server ~= "" then do
call ProcessLists()
end
do i = 1 to lists.0
if lists.i.addr ~= "" then do
call Export(lists.i.name,lists.i.addr)
end
end
call Import()
if args.loop = "" then leave
address command args.loop
end
end
call log(7,"done")
/*** Final cleanup ***/
BREAK_C:
BREAK_D:
BREAK_E:
BREAK_F:
HALT:
RC = 0
ERROR:
IOERR:
SYNTAX:
IF RC ~= 0 THEN DO
SAY "Error: " rc errortext(rc) "Line" sigl
END
/*** Logout ***/
if account ~= 0 then do
call UMSLogout(account)
account = 0
end
exit
/*** Check for new messages from the server ***/
Import: PROCEDURE expose account GroupPrefix args. lists. ProgramName
call UMSInitConsts()
f_012 = UMSMakeFlags(0,1,2);
f_E = UMSMakeFlags(14); f_F = UMSMakeFlags(15);
f_EF = UMSMakeFlags(14,15)
f_X = UMSMakeFlags();
f_OldJunk = UMSMakeFlags(UMSUSTAT_Old,UMSUSTAT_Junk);
call log(7,"moving messages from all lists into groups")
call UMSSelectFlags(account, "L", f_X, f_012,,, "L", f_X, f_X)
call UMSSelectField(account, "L", UMSMakeFlags(0), f_X,,, UMSCODE_Group, "", true)
call UMSSelectFlags(account, "L", UMSMakeFlags(1), f_X,,, "U", UMSMakeFlags(UMSUSTAT_ReadAccess, UMSUSTAT_Old), UMSMakeFlags(UMSUSTAT_ReadAccess))
call UMSSelectFlags(account, "L", UMSMakeFlags(2), f_X,,, "G", UMSMakeFlags(UMSGSTAT_Parked), f_X)
last = 0; numMsgs = 0;
do forever
last = UMSSearchFlags(account, "L", f_012, f_012, last)
if last = 0 then leave
drop msg.
if UMSReadMsgField(account, last, msg., UMSCODE_ReplyName, TRUE) then do
parse var msg.UMSCODE_ReplyName test "'" listname "'"
if (upper(test) = "MAILINGLIST ") & (listname ~= "") & ~FindServedList(listname) then do
if ~UMSReadMsgAll(account, last, msg., TRUE) then do
call CheckErr
/* workaround for ARexx bug with msgs >64kB */
call UMSSelectMsg(account,"U", f_X, UMSMakeFlags(UMSUSTAT_Old), last)
iterate
end
/* insert into config var, if not already there */
call CheckEntry(listname,msg.UMSCODE_ReplyAddr)
msg.UMSCODE_Group = GroupPrefix || listname
drop msg.UMSCODE_ToName msg.UMSCODE_ToAddr
drop msg.UMSCODE_ReplyName msg.UMSCODE_ReplyAddr msg.UMSCODE_Folder
msg.SOFTLINK = last
msg.NOUPDATE = args.nodeamonaccount
drop msg.UMSCODE_Comments
/* DupeCheck */
call UMSSelectFlags(account, "L", f_X, f_EF,,, "L", f_X, f_X)
call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, msg.UMSCODE_Group, TRUE)
call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
if UMSSearchFlags(account, "L", f_EF, f_EF) = 0 then do
num = UMSWriteMsg(account, msg.)
if num = 0 then do
call CheckErr
end; else do
call UMSSelectMsg(account,"U", f_OldJunk, f_X, last)
call UMSSelectMsg(account,"U", UMSMakeFlags(args.bit), f_X, num)
numMsgs = numMsgs + 1;
call log(8,"forwarded message written by '"msg.UMSCODE_FromName"' to '"msg.UMSCODE_Group"'")
end
end; else do
call UMSSelectMsg(account,"U", f_OldJunk, f_X, last)
call log(2,"rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName ||,
"' intended for '"msg.UMSCODE_Group"'")
end
end
end; else call CheckErr
end
call log(6+(numMsgs=0),"imported" numMsgs "messages");
return
/*** Check for new messages from the users ***/
Export: PROCEDURE Expose account GroupPrefix ProgramName args.
listname=arg(1); listaddr = arg(2);
call UMSInitConsts()
f_012 = UMSMakeFlags(0,1,2);
f_E = UMSMakeFlags(14); f_F = UMSMakeFlags(15);
f_EF = UMSMakeFlags(14,15)
f_X = UMSMakeFlags();
f_Old = UMSMakeFlags(UMSUSTAT_Old); f_Junk = UMSMakeFlags(UMSUSTAT_Junk);
f_Bit = UMSMakeFlags(args.bit);
groupname = GroupPrefix || listname
call UMSSelectFlags(account, "L", f_X, f_012 ,,, "L", f_X, f_X);
call UMSSelectField(account, "L", UMSMakeFlags(0), f_X,,, UMSCODE_Group, groupname, TRUE)
call UMSSelectFlags(account, "L", UMSMakeFlags(1), f_X,,, "U", UMSMakeFlags(UMSUSTAT_ReadAccess, args.bit), UMSMakeFlags(UMSUSTAT_ReadAccess))
call UMSSelectFlags(account, "L", UMSMakeFlags(2), f_X,,, "G", UMSMakeFlags(UMSGSTAT_Parked), f_X)
last = 0; numMsgs = 0;
do forever
last = UMSSearchFlags(account, "L", f_012, f_012, last)
if last = 0 then leave
drop msg.
if ~UMSReadMsgAll(account, last, msg., TRUE) then do
call CheckErr
/* workaround for ARexx bug with msgs >64kB */
call UMSSelectMsg(account,"U", f_X, f_Old, last)
iterate
end
drop msg.UMSCODE_Group msg.UMSCODE_Comments
msg.SOFTLINK = last
msg.UMSCODE_ToName = "Mailinglist '"listname"'"
if listaddr ~= "" then
msg.UMSCODE_ToAddr = listaddr
else
drop msg.UMSCODE_ToAddr
/* Dupe Check */
call UMSSelectFlags(account, "L", f_X, f_EF,,, "L", f_X, f_X)
call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, "", TRUE)
call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
if UMSSearchFlags(account, "L", f_EF, f_EF) = 0 then do
num = UMSWriteMsg(account, msg.)
if num = 0 then
call CheckErr
else do
call UMSSelectMsg(account,"U", f_Junk, f_X, num)
call UMSSelectMsg(account,"U", f_bit, f_X, last)
call UMSExportedMsg(account,last)
numMsgs = numMsgs + 1;
call log(8,"forwarded message written by '"msg.UMSCODE_FromName"' from '"groupname"'")
end
end; else do
call UMSSelectMsg(account,"U", f_bit, f_X, last)
logtxt = "rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName || "' in '"groupname"'"
call log(2,logtxt)
call UMSCannotExport(account,last,logtxt)
/* drop logtxt superfluous */
end
end
call log(6+(numMsgs=0),"exported" numMsgs "messages to list '"listname"'");
return
/*** check if mailinglist is in our list ***/
CheckEntry: /*PROCEDURE expose Lists. and everyhing for WriteConfig */
listname=arg(1); listaddr=arg(2);
i = FindClientList(listname);
if i > 0 then do
if upper(lists.i.addr) = upper(listaddr) then do
return true
end; else do
/* address changed */
lists.i.addr = listaddr
end
end; else do
i = lists.0 +1 /* lists.0 is index and count */
lists.i.name = listname
lists.i.addr = listaddr
lists.0 = i
end
lists.status = lists.status || "m"
return WriteConfig()
/*** Show a message for debugging ***/
ShowMsg:
do field = 0 to UMSNUMFIELDS
if (symbol("msg."field) = "VAR") & (field ~= UMSCODE_MsgText) & (field ~= UMSCODE_Comments) then do
say "Field #"field": '"msg.field"'"
end
end
return
/*** config stuff ***/
/** list support routines **/
CheckAccess: PROCEDURE expose lists. true false
user = translate(arg(1),,","xrange('00'x,'1F'x)||xrange('80'x,'9F'x),); /* hg/04-may-95*/
string = user","arg(2)
list = upper(arg(3))
do i = 1 to lists.0
if (lists.i.addr = "") & (upper(lists.i.name) = list) then do
return MatchPattern( lists.i.access, string, "N")
end
end
return false
FindServedList: PROCEDURE expose Lists.
searchname = upper(arg(1));
do i = 1 to lists.0
if (lists.i.addr = "") then do /* splitted for short curcuit evaluation */
if (searchname = upper(lists.i.name)) then do
return i;
end
end
end
return 0;
FindClientList: PROCEDURE expose Lists.
searchname = upper(arg(1));
do i = 1 to lists.0
if (lists.i.addr ~= "") then do /* splitted for short curcuit evaluation */
if (searchname = upper(lists.i.name)) then do
return i;
end
end
end
return 0;
FindInAddrList: PROCEDURE expose Lists. /*hg/30-Apr-95*/
user = arg(1); naddr = arg(2); addrList = upper(arg(3)) /* listNum"."mail */
do j = 1 to lists.addrList.0
if (lists.addrList.j.name = user) then do /* splitted for short curcuit evaluation */
if (lists.addrList.j.addr = naddr) then do
return j;
end
end
end
return 0;
AddrList2Str: PROCEDURE expose Lists. /*hg/30-Apr-95*/
addrList = upper(arg(1)) /* listNum"."mail */
temp = ""
do j = 1 to lists.addrList.0
if j ~= 1 then temp = temp || '0A'x
temp = temp || lists.addrList.j.name
if lists.addrList.addr ~= "" then temp = temp","lists.addrList.j.addr
end
return temp;
Str2AddrList: PROCEDURE expose Lists. /*hg/30-Apr-95*/
addrList = upper(arg(1)) /* listNum"."mail */
string = arg(2);
j = 0
do while string ~= ""
parse var string usrname "," usraddr '0A'x string
j = j + 1
lists.addrList.j.name = strip(usrname)
lists.addrList.j.addr = strip(usraddr)
end
lists.addrList.0 = j
return
AddToAddrList: PROCEDURE expose lists. true false /*hg/30-Apr-95*/
user = arg(1); naddr = arg(2); /* listname = arg(3) */
mail = upper(arg(4)); /* statusflag = arg(5); */
i = FindServedList(arg(3));
if i > 0 then do
user = translate(user,,","xrange('00'x,'1F'x)||xrange('80'x,'9F'x),);
j = FindInAddrList(user,naddr,i"."mail)
if j = 0 then do /* not already in list */
j = lists.i.mail.0+1
lists.i.mail.j.name = user
lists.i.mail.j.addr = naddr
lists.i.mail.0 = j
lists.i.status = lists.i.status || arg(5);
end;
return true
end;
return false
RemFromAddrList: PROCEDURE expose lists. true false /*hg/30-Apr-95*/
user = arg(1); naddr = arg(2); /* listname = arg(3) */
mail = upper(arg(4)); /* statusflag = arg(5); */
i = FindServedList(arg(3));
if i > 0 then do
user = translate(user,,","xrange('00'x,'1F'x)||xrange('80'x,'9F'x),);
j = FindInAddrList(user,naddr,i"."mail)
if j ~= 0 then do
k = lists.i.mail.0;
if j < k then do
/* insert last entry at current position */
lists.i.mail.j.name = lists.i.mail.k.name
lists.i.mail.j.addr = lists.i.mail.k.addr
end;
drop lists.i.mail.k.name
drop lists.i.mail.k.addr
lists.i.mail.0 = k-1;
lists.i.status = lists.i.status || arg(5);
return true
end;
end
return false
FindUser: PROCEDURE expose lists. true false
return FindInAddrList(arg(1),arg(2),arg(3));
AddUser: PROCEDURE expose lists. true false
return AddToAddrList(arg(1),arg(2),arg(3),"MAIL","u");
RemUser: PROCEDURE expose lists. true false mail
return RemFromAddrList(arg(1),arg(2),arg(3),"MAIL","u");
AddOwner: PROCEDURE expose lists. true false
return AddToAddrList(arg(1),arg(2),arg(3),"OWNERS","o");
RemOwner: PROCEDURE expose lists. true false mail
return RemFromAddrList(arg(1),arg(2),arg(3),"OWNERS","o");
/** **/
SendAdminMail: PROCEDURE expose account lists. args. ProgramName
/* sends Message with MsgText arg(2) to all owners of list arg(1) */
name = arg(1); text = arg(2)
call UMSInitConsts()
/* drop msg. superfluous */
/* todo
msg.UMSCODE_ReplyName = lists.server
msg.UMSCODE_ReplyAddr = lists.server"@"lists.hostname
msg.UMSCODE_LogicalToName = "Owners of List '"name"'"
if ~args.nodeamonaccount then do
msg.UMSCODE_LogicalToAddr = "listowners"@"lists.hostname
end
*/
msg.UMSCODE_MsgText = text;
msg.UMSCODE_Subject = "ListServer Request"
/*** write mails ***/
firstnum = 0; newnum = 0;
if lists.name.owner.0 = 0 then /* no owners defined */
msg.UMSCODE_ToName = Lists.Owner
firstnum = UMSWriteMsg(account,msg.)
if firstnum = 0 then call CheckErr
end; else
do j = 1 to lists.name.owners.0
msg.UMSCODE_ToName = lists.name.owners.j.name
msg.UMSCODE_ToAddr = lists.name.owners.j.addr
newnum = UMSWriteMsg(account,msg.)
if newnum = 0 then do
call CheckErr
end; else do
if firstnum = 0 then firstnum = newnum;
end
end
if newnum ~= firstnum then call log(9,"write admin mail:" firstnum".."newnum)
return
ParseCommandArgs: PROCEDURE expose arguments carg. MsgText true false LF
if ~ReadArgs(arguments,arg(1),"carg.") then do
MsgText = MsgText || "wrong arguments! Template:" arg(1) ||LF
return FALSE
end;
return true;
SendNotification: PROCEDURE expose carg. msg. lists. account args. ProgramName
call UMSInitConsts();
/* drop notifymsg. superfluous */
notifymsg.UMSCODE_ToName = carg.name
notifymsg.UMSCODE_ToAddr = carg.addr
notifymsg.UMSCODE_RefID = msg.UMSCODE_MsgID
notifymsg.UMSCODE_FromName = lists.server
notifymsg.UMSCODE_Attributes = "ALIAS" lists.server
if ~args.nodeamonaccount then do
notifymsg.UMSCODE_ReplyName = Lists.Owner
end
notifymsg.UMSCODE_Subject = "Listserver notification" /* todo */
notifymsg.UMSCODE_MsgText = arg(1);
if UMSWriteMsg(account, notifymsg.) = 0 then call CheckErr
return
ProcessCommand: PROCEDURE EXPOSE msg. Lists. LF MsgText account args. ProgramName,
ConfigChanged quit
/* called from ProcessCtrlMsg */
command = arg(1); arguments = arg(2);
call UMSInitConsts();
/* not yet finished hg/01-may-95
if command = "APPROVE" then do
if ~ParseCommandArgs("PASSWORD/A,COMMAND/A,LIST/A,NAME/K,ADDR/K") then
return false;
i = FindList(carg.list);
if i = 0 then do
MsgText = MsgText || "mailinglist not found"LF
return false;
end;
approved = (cargs.password = lists.i.password);
command = upper(carg.command);
end;
*/
select
when (command = "QUIT") | (command = "STOP") then do
MsgText = MsgText || "ok, stopped processing you mail"LF
quit = true
end
when command = "HELP" then do
if lists.helpfile = "" then
MsgText = MsgText || "sorry, no help available"LF
else
MsgText = MsgText || Include(lists.helpfile) ||LF
end
when (command = "USERS") | (command = "WHO") then do
if ParseCommandArgs("LIST/A") then do
i = FindList(carg.list);
if i > 0 then do
do j = 1 to lists.i.mail.0
MsgText = MsgText || lists.i.mail.j.name "<"lists.i.mail.j.addr">"LF
end
end; else do
MsgText = MsgText || "mailinglist not found"LF
end
end
end
when (command = "INDEX") | (command = "LISTS") then do
do i = 1 to lists.0
if lists.i.addr = "" then
MsgText = MsgText || lists.i.name ||LF
end
end
when command = "WHICH" then do /**hg/01-may-95*/
do i = 1 to lists.0
if lists.i.addr = "" then
if FindUser(msg.UMSCODE_FromName,msg.UMSCODE_FromAddr,lists.i.addr) > 0 then
MsgText = MsgText || " "lists.i.name ||LF
end
end
when (command = "ADD") | (command = "SUBSCRIBE") then do
carg.name = msg.UMSCODE_FromName;
carg.addr = msg.UMSCODE_FromAddr;
if ParseCommandArgs("LIST/A,NAME/K,ADDR/K") then do
if ~CheckAccess(msg.UMSCODE_FromName,msg.UMSCODE_FromAddr,carg.list) then do
MsgText = MsgText || 'Mailinglist "'carg.list '"is private, ask the postmaster'LF /* todo */
end; else do
if AddUser(carg.name, carg.addr, carg.list) then do
configChanged = true
MsgText = MsgText || "added" carg.name "<"carg.addr'> to mailinglist "'carg.list'"'LF
if (carg.name ~= msg.UMSCODE_FromName) | (carg.addr ~= msg.UMSCODE_FromAddr) then do
call SendNotification("You have been added to the mailinglist '"carg.list"' by"LF||,
msg.UMSCODE_FromName "<"msg.UMSCODE_FromAddr">"LF);
end
end; else do
MsgText = MsgText || "error, not added"LF /* todo */
end
end
end
end
when (command = "DELETE") | (command = "REMOVE") | (command = "UNSUBSCRIBE") then do
carg.name = msg.UMSCODE_FromName;
carg.addr = msg.UMSCODE_FromAddr;
if ParseCommandArgs("LIST/A,NAME/K,ADDR/K") then do
if RemUser(carg.name, carg.addr, carg.list) then do
configChanged = true
MsgText = MsgText || "removed" carg.name "<"carg.addr'> from mailinglist "'carg.list'"'LF
if (carg.name ~= msg.UMSCODE_FromName) | (carg.addr ~= msg.UMSCODE_FromAddr) then do
call SendNotification("You have been removed from the mailinglist '"carg.list"' by"LF||,
msg.UMSCODE_FromName "<"msg.UMSCODE_FromAddr">"LF)
end
end; else do
MsgText = MsgText || "error, not removed"LF /* todo */
end
end
end
when (command = "DESCRIPTION") | (command = "DESC") | (command = "INFO") then do /*hg/30-Apr-95*/
if ParseCommandArgs("LIST/A") then do
i = FindList(carg.list);
if i > 0 then do
if lists.i.descfile = "" then do
MsgText = MsgText || "sorry, no description available for this list"LF
end; else do
MsgText = MsgText || Include(lists.i.descfile) ||LF
end
end; else do
MsgText = MsgText || "mailinglist not found"LF
end
end
end
otherwise do
MsgText = MsgText || "unknown command"LF
RETURN FALSE
end
END; /* select */
RETURN true
ProcessCtrlMsg: PROCEDURE Expose account Lists. ConfigChanged args. ProgramName
call UMSInitConsts();
curmsg = arg(1); LF = '0A'x;
/* drop msg. superfluous */
if ~UMSReadMsgAll(account, curmsg, msg., TRUE) then do
call CheckErr
/* workaround for ARexx bug with msgs >64kB */
call UMSSelectMsg(account,"U", UMSMakeFlags(), UMSMakeFlags(UMSUSTAT_Old), curmsg)
end; else do
if symbol("msg."UMSCODE_FromAddr) ~= "VAR" then msg.UMSCODE_FromAddr = ""
MsgText = "Listserver startup"LF
validcommand = false; quit = false;
do while (msg.UMSCODE_MsgText ~= "") & ~quit
parse var msg.UMSCODE_MsgText command '0A'x msg.UMSCODE_msgText
command = strip(command)
if command ~= "" then do
parse var command command " " arguments
upper command
MsgText = MsgText || LF ">" command arguments ||LF||LF
validcommand = ProcessCommand(command,arguments) | validCommand;
end
end
MsgText = MsgText ||LF
if ~validcommand then do
MsgText = MsgText ||LF|| "There was no valid command in this message. Here's some help:"LF ,
|| Include(lists.helpfile) ||LF
end
/*** done, send the logfile ***/
/* drop newmsg. superfluous */
if symbol("msg."UMSCODE_ReplyName) ~= "VAR" then do
newmsg.UMSCODE_ToName = msg.UMSCODE_FromName
newmsg.UMSCODE_ToAddr = msg.UMSCODE_FromAddr
end; else do
newmsg.UMSCODE_ToName = msg.UMSCODE_ReplyName
if symbol("msg."UMSCODE_ReplyAddr) = "VAR" then do
newmsg.UMSCODE_ToAddr = msg.UMSCODE_ReplyAddr
end
end
newmsg.UMSCODE_RefID = msg.UMSCODE_MsgID
newmsg.UMSCODE_FromName = Lists.Server
if ~args.nodeamonaccount then do
newmsg.UMSCODE_ReplyName = Lists.Owner
end
newmsg.UMSCODE_Subject = "Listserver logfile" /* todo */
newmsg.UMSCODE_MsgText = MsgText
if UMSWriteMsg(account, newmsg.) = 0 then call CheckErr
call UMSSelectMsg(account,"U", UMSMakeFlags(UMSUSTAT_Old), UMSMakeFlags(), curmsg)
end;
return
ReadConfig: PROCEDURE expose lists. args. ProgramName account TRUE FALSE
lists.status = "";
temp = UMSReadConfig(account, ProgramName".MailingLists")
if temp = "" then return "MailingLists"
i = 0
do while temp ~= ""
i = i + 1
parse var temp lists.i.name "," lists.i.addr '0A'x temp
lists.i.name = strip(lists.i.name);
lists.i.addr = strip(lists.i.addr)
end
lists.0 = i;
/* global config */
lists.server = UMSReadConfig(account, ProgramName".Server")
if lists.server ~= "" then do
if args.nodeamonaccount then do
lists.address = UMSReadConfig(account, ProgramName".Address")
if lists.address = "" then return ".Address"
end; else do
lists.hostname = UMSReadConfig(account, ProgramName".Hostname")
if lists.helpfile = "" then return ".Hostname"
end
Lists.Owner = UMSReadConfig(account, ProgramName".Owner")
if Lists.Owner = "" then Lists.Owner = "postmaster"
lists.helpfile = UMSReadConfig(account, ProgramName".Helpfile")
end;
/* per list config */
do i = 1 to lists.0
if lists.i.addr = "" then do
if lists.server = "" then return ".Server"
lists.i.group = UMSReadConfig(account, ProgramName"."lists.i.name".group")
if lists.i.group = "" then return lists.i.name".group"
lists.i.status = UMSReadConfig(account, ProgramName"."lists.i.name".status")
lists.i.status = lists.i.status || "#" /*delemitter */
lists.i.descfile = UMSReadConfig(account, ProgramName"."lists.i.name".descfile")
lists.i.access = UMSReadConfig(account, ProgramName"."lists.i.name".access")
lists.i.alias = UMSReadConfig(account, ProgramName"."lists.i.name".alias")
temp = UMSReadConfig(account, ProgramName"."lists.i.name".users")
if temp = "" then return lists.i.name".users"
call Str2AddrList(i".MAIL", temp);
temp = UMSReadConfig(account, ProgramName"."lists.i.name".owners")
call Str2AddrList(i".OWNER", temp);
end
end
return " "
WriteVar: PROCEDURE expose lists. args. ProgramName account TRUE FALSE
varname = upper(arg(1)); contents = arg(2);
if contents ~= "" then do
call UMSWriteConfig(account, ProgramName"."varname, contents, args.name,)
call checkerr()
end
return
WriteChangedVar: PROCEDURE expose lists. i args. ProgramName account TRUE FALSE
varname = upper(arg(1)); contents = arg(2);
if pos(arg(3),lists.i.status) ~= 0 then do
call UMSWriteConfig(account, ProgramName"."varname, contents, args.name,)
call checkerr()
end
return
WriteConfig: PROCEDURE expose lists. args. ProgramName account TRUE FALSE
/* global config is never written, why should it?
if lists.server ~= "" then do
call WriteVar("server", lists.server)
if args.nodeamonaccount then do
call WriteVar("address", lists.address)
end; else do
call WriteVar("hostname", lists.hostname)
end
call WriteVar("Owner", lists.Owner)
call WriteVar("helpfile", lists.helpfile)
end
*/
ltemp = ""
do i = 1 to lists.0
if i ~= 1 then ltemp = ltemp || '0A'x
ltemp = ltemp || lists.i.name","lists.i.addr
if lists.i.addr = "" then do /* served here */
temp = AddrList2Str(i".MAIL");
call WriteChangedVar(lists.i.name".Users", temp, "u");
/* this may only be changed by the postmaster, so why write it?
call WriteVar(lists.i.name".group", lists.i.group);
call WriteVar(lists.i.name".descfile", lists.i.descfile);
call WriteVar(lists.i.name".alias", lists.i.alias);
*/
/* this part schould become maintainable via mail
temp = AddrList2Str(i".OWNER");
call WriteChangedVar(lists.i.name".Owners", temp, "o");
parse var lists.i.status temp "#" .
call WriteChangedVar(lists.i.name".Status", temp, "s");
call WriteChangedVar(lists.i.name".Password", lists.i.password, "p");
*/
end
end
i = pos("m",lists.status);
if i ~= 0 then do /* write only if changed */
call WriteVar("Mailinglists", ltemp);
lists.status = delstr(lists.status,i,1); /*due to CheckEntry() */
end;
return TRUE
ShowListConfig: PROCEDURE expose Lists.
addrList = upper(arg(1));
do j = 1 to lists.addrList.0
say " " lists.addrList.j.name lists.addrList.j.addr
end
return
ShowConfig: PROCEDURE expose lists.
say "Managing" lists.0 "lists!" || '0A'x
do i = 1 to lists.0
if lists.i.addr ~= "" then say "Client:" lists.i.name lists.i.addr
end
say ""
do i = 1 to lists.0
if lists.i.addr = "" then do
say "Server: " lists.i.name
call ShowListConfig(i".MAIL");
say "Owners:"; call ShowListConfig(i".OWNER");
say
end
end
return
/*** ProcessLists ***/
DupeCheck:
call UMSSelectFlags(account, "L", f_X, f_CDEF,,, "L", f_X, f_X)
call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, "", TRUE)
call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_ToName, msg.UMSCODE_ToName, TRUE)
call UMSSelectField(account, "L", f_D, f_X,,, UMSCODE_ToAddr, msg.UMSCODE_ToAddr, TRUE)
call UMSSelectField(account, "L", f_C, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
if UMSSearchFlags(account, "L", f_CDEF, f_CDEF) ~= 0 then do
logtxt = "rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName || "' intended to <"msg.UMSCODE_ToAddr">"
call log(2,logtxt)
call UMSCannotExport(account,curmsg,logtxt)
/* drop logtxt superfluous */
return false
end
RETURN TRUE
SendListMails:
/* set up mail hdr */
msg.UMSCODE_ReplyName = longname
msg.UMSCODE_LogicalToName = longname
if ~args.nodeamonaccount then do
msg.UMSCODE_ReplyAddr = shortname"@"lists.hostname
msg.UMSCODE_LogicalToAddr = shortname"@"lists.hostname
msg.UMSCODE_RfcAttr = '"Errors-To:' lists.owner'@'lists.hostname'"'
end
if symbol("msg."UMSCODE_MsgText) ~= "VAR" then msg.UMSCODE_MsgText = ""
msg.UMSCODE_MsgText = msg.UMSCODE_MsgText || Tailer
drop msg.UMSCODE_Group
/* write mails */
lognum = 0;
do j = 1 to lists.i.mail.0
msg.UMSCODE_ToName = lists.i.mail.j.name
msg.UMSCODE_ToAddr = lists.i.mail.j.addr
if (msg.UMSCODE_ToName ~= msg.UMSCODE_fromName),
| (msg.UMSCODE_ToAddr ~= msg.UMSCODE_fromAddr) then do
if DupeCheck() then do
newnum = UMSWriteMsg(account,msg.)
if newnum = 0 then do
call CheckErr
call UMSCannotExport(account,curmsg,"problems with UMSWriteMsg()")
end; else do
call UMSSelectMsg(account,"U", f_Junk, f_X, newnum)
call UMSExportedMsg(account,curmsg)
if lognum = 0 then lognum = newnum
end
end
end
end
if lognum ~= 0 then call log(9,"write mail:" lognum".."newnum)
return
ProcessLists: procedure expose account lists. args. ProgramName account TRUE FALSE
call UMSInitConsts(); LF = '0A'x;
l_new = UMSMakeFlags(0)
l_notp = UMSMakeFlags(1)
l_priv = UMSMakeFlags(2)
l_name = UMSMakeFlags(3)
l_group = UMSMakeFlags(4)
if args.nodeamonaccount then l_bit = UMSMakeFlags(10) /* kai hopes this is free */
else l_bit = l_new
l_newmail = BITOR(l_new,BITOR(l_priv,l_notp));
l_newlist = BITOR(l_newmail,l_name)
l_newnews = BITOR(l_bit,BITOR(l_notp,l_group))
f_X = UMSMakeFlags();
f_C = UMSMakeFlags(12); f_D = UMSMakeFlags(13);
f_E = UMSMakeFlags(14); f_F = UMSMakeFlags(15);
f_EF = UMSMakeFlags(14,15); f_CDEF = UMSMakeFlags(12,13,14,15);
f_Junk = UMSMakeFlags(UMSUSTAT_Junk); f_old = UMSMakeFlags(UMSUSTAT_Old)
f_Bit = UMSMakeFlags(args.bit);
call UMSSelectFlags(account,"L",,l_new,,,"L",l_new,l_new)
call UMSSelectFlags(account,"L",l_new,,,,"U",UMSMakeFlags(UMSUSTAT_Old, UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess),UMSMakeFlags(UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess))
if args.nodeamonaccount then do
call UMSSelectFlags(account,"L",,l_bit,,,"L",l_bit,l_bit)
call UMSSelectFlags(account,"L",l_bit,,,,"U",UMSMakeFlags(args.bit, UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess),UMSMakeFlags(UMSUSTAT_ReadAccess, UMSUSTAT_ViewAccess))
end
call UMSSelectFlags(account,"L",l_notp,,,,"G",UMSMakeFlags(UMSGSTAT_Parked), f_X)
call UMSSelectField(account,"L",l_priv,,,,UMSCODE_Group,"",true)
num = UMSSelectFlags(account,"L",,,,,"L",l_newmail,l_newmail)
call log(7,"new mails overall:" num)
/*** process received control mails ***/
call log(7,"Processing control mails:")
call UMSSelectFlags(account,"L",,l_name,,,"L",l_name,l_name)
call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,lists.server)
call log(7,"new mail for <"lists.server">:",
UMSSelectFlags(account,"L",,,,,"L",l_newlist,l_newlist))
configChanged = false
curmsg = 0;
do forever
curmsg = UMSSearchFlags(account,"L",l_newlist,l_newlist,curmsg)
if curmsg = 0 then leave
call ProcessCtrlMsg(curmsg);
end
if configChanged then do
call log(7,"changed config by control mail")
if ~ WriteConfig() then call log(2,"couldn't write config")
end
do i = 1 to lists.0
if lists.i.addr ~= "" then iterate
shortname = lists.i.name
longname = "Mailinglist '"lists.i.name"'"
/* create Tailer; no stems: faster */
if args.nodeamonaccount then do
Tailer2 = longname 'Admin: "'Lists.Owner '<'lists.address'>"'
Tailer3 = 'Send listserv-requests to "'lists.server '<'lists.address'>"'
end; else do
Tailer2 = longname 'Admin: <'Lists.Owner'@'lists.hostname'>'
Tailer3 = 'Send listserv-requests to <'lists.server'@'lists.hostname'>'
end
Tailer_length = max(length(tailer2), length(tailer3)) + 2
Tailer = copies("_", tailer_length) ||LF|| center(tailer2, tailer_length) ||LF|| center(tailer3, tailer_length) ||LF
/* drop Tailer. superfluous */
/*** process received mails in lists ***/
call log(7,"processing list <"shortname">")
call UMSSelectFlags(account,"L",,l_name,,,"L",l_name,l_name)
call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,longname,true)
call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,shortname,true)
if lists.i.alias ~= "" then do
call UMSSelectField(account,"L",l_name,,,,UMSCODE_ToName,lists.i.alias,true)
end
num = UMSSelectFlags(account,"L",,,,,"L",l_newlist,l_newlist)
call log(6+(num=0),"new mail for <"shortname"> or <"longname">:" num)
curmsg = 0;
do forever
curmsg = UMSSearchFlags(account,"L",l_newlist,l_newlist,curmsg)
if curmsg = 0 then leave
drop msg.
if ~UMSReadMsgAll(account, curmsg, msg., TRUE) then do
call CheckErr
/* workaround for ARexx bug with msgs >64kB */
call UMSSelectMsg(account,"U", f_X, f_Old, curmsg)
end; else do
if symbol("msg."UMSCODE_FromAddr) ~= "VAR" then msg.UMSCODE_FromAddr = ""
call log(8,curmsg msg.UMSCODE_FromName "<"msg.UMSCODE_FromAddr"> :" msg.UMSCODE_subject)
/*** write news article ***/
if lists.i.group ~= "" then do
/*** set up news hdr ***/
msg.UMSCODE_Group = lists.i.group
msg.SOFTLINK = curmsg
msg.NOUPDATE = args.nodeamonaccount
drop msg.hardlink
drop msg.UMSCODE_Comments
/* Dupe Check */
call UMSSelectFlags(account, "L", f_X, f_EF,,, "L", f_X, f_X)
call UMSSelectField(account, "L", f_F, f_X,,, UMSCODE_Group, msg.UMSCODE_Group, TRUE)
call UMSSelectField(account, "L", f_E, f_X,,, UMSCODE_MsgID, msg.UMSCODE_MsgID, TRUE)
if UMSSearchFlags(account, "L", f_EF, f_EF) ~= 0 then do
call log(2,"rejected dupe <"msg.UMSCODE_MsgID"> written by '"msg.UMSCODE_FromName ||,
"' intended for '"msg.UMSCODE_Group"'")
end; else do
/*** write article ***/
newnum = UMSWriteMsg(account,msg.)
if newnum = 0 then call CheckErr
else do
call log(9,"write article:" newnum)
end
call SendListMails /* mail hdr is set up there */
end
end
call UMSSelectMsg(account,"U", f_Old, f_X, curmsg)
end
end
/*** process new news ***/
if lists.i.group ~= "" then do
listgroup = lists.i.group
call UMSSelectFlags(account,"L",,l_group,,,"L",l_group,l_group)
call UMSSelectField(account,"L",l_group,,,,UMSCODE_Group,listgroup,true)
num = UMSSelectFlags(account,"L",,,,,"L",l_newnews,l_newnews)
call log(6+(num=0), "New articles in group <"listgroup">:" num)
curmsg = 0;
do forever
curmsg = UMSSearchFlags(account,"L",l_newnews,l_newnews,curmsg)
if curmsg = 0 then leave
drop msg.
if ~UMSReadMsgAll(account, curmsg, msg., TRUE) then do
call CheckErr
/* workaround for ARexx bug with msgs >64kB */
call UMSSelectMsg(account,"U", f_X, f_Old, curmsg)
end; else do
if symbol("msg."UMSCODE_fromAddr) ~= "VAR" then msg.UMSCODE_FromAddr = ""
call log(8,curmsg msg.UMSCODE_fromName "<"msg.UMSCODE_FromAddr"> :" msg.UMSCODE_subject)
/*** set up mail hdr ***/
drop msg.hardlink msg.UMSCODE_Comments
msg.softlink = curmsg
call SendListMails; /* rest of mail hdr ist set there */
call UMSSelectMsg(account,"U", f_bit, f_X, curmsg)
end
end
end
end
return
/*** Support ***/
FindFlag: PROCEDURE expose account ProgramName TRUE
temp = UMSReadConfig(account,"flags.user",,TRUE) /* need param to lock! */
if temp = "" then do
myflag = -1
freeflag = 0
end; else do
do until temp = ""
parse var temp flagnum flagkey '0A'x temp
flag.flagnum = strip(flagkey)
end
freeflag = -1
myflag = -1
do i = 0 to 15
if flag.i = programname then do
myflag = i
leave
end; else do
if (upper(flag.i) = "UNUSED") & (freeflag = -1) then do
freeflag = i
end
end
end
end
if myflag = -1 then do
if freeflag ~= -1 then do
/* I've been started for the first time. I'm reserving first free flag */
myflag = freeflag
flag.myflag = programname
do i = 0 to 15
if symbol("flag."i) ~= "VAR" then do
if (i >= 4) & (i <= 12) then do
flag.i = "Reserved"
end; else do
flag.i = "Unused"
end
end
temp = temp || i flag.i || '0A'x
end
if ~UMSWriteConfig(account,"flags.user",temp,,TRUE) then do /* need param to unlock! */
call CheckErr
end
end
end
return myflag
Include: PROCEDURE expose account args.debuglevel ProgramName
if open(file,arg(1),r) then do
string = readch(file,64000)
call close(file)
end; else do
call log(2,"cannot read include-file '"arg(1)"'!")
string = ""
end
return string
log: PROCEDURE expose account args.debuglevel ProgramName
level = arg(1); text = ProgramName":" arg(2);
if level <= args.debuglevel then say text
call UMSLog(account, level, text)
return 0
CheckErr: PROCEDURE expose account args.debuglevel ProgramName
err = UMSErrNum(account)
if err ~= 0 then do
call log(3,"UMS Error #"err":" UMSErrTxt(account))
end
return 0